home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch10 / SierpG2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-08  |  4KB  |  113 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSierpG2 
  3.    Caption         =   "SierpG2"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   900
  7.    ClientWidth     =   5310
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4335
  11.    ScaleWidth      =   5310
  12.    Begin VB.TextBox txtDepth 
  13.       Height          =   285
  14.       Left            =   480
  15.       MaxLength       =   3
  16.       TabIndex        =   0
  17.       Text            =   "5"
  18.       Top             =   0
  19.       Width           =   375
  20.    End
  21.    Begin VB.PictureBox picCanvas 
  22.       AutoRedraw      =   -1  'True
  23.       Height          =   4335
  24.       Left            =   960
  25.       ScaleHeight     =   285
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   285
  28.       TabIndex        =   3
  29.       Top             =   0
  30.       Width           =   4335
  31.    End
  32.    Begin VB.CommandButton cmdGo 
  33.       Caption         =   "Go"
  34.       Default         =   -1  'True
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   1
  38.       Top             =   480
  39.       Width           =   615
  40.    End
  41.    Begin VB.Label Label1 
  42.       Caption         =   "Depth"
  43.       Height          =   255
  44.       Index           =   0
  45.       Left            =   0
  46.       TabIndex        =   2
  47.       Top             =   0
  48.       Width           =   495
  49.    End
  50. Attribute VB_Name = "frmSierpG2"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = False
  53. Attribute VB_PredeclaredId = True
  54. Attribute VB_Exposed = False
  55. Option Explicit
  56. Private Sub cmdGo_Click()
  57. Const PI = 3.14159265
  58. Dim depth As Integer
  59. Dim total_length As Single
  60. Dim start_x As Single
  61. Dim start_y As Single
  62. Dim wid As Single
  63. Dim hgt As Single
  64.     picCanvas.Cls
  65.     MousePointer = vbHourglass
  66.     DoEvents
  67.     ' Get the parameters.
  68.     If Not IsNumeric(txtDepth.Text) Then txtDepth.Text = "5"
  69.     depth = CInt(txtDepth.Text)
  70.     ' See how big we can make the curve.
  71.     wid = picCanvas.ScaleWidth * 0.9
  72.     hgt = picCanvas.ScaleHeight * 0.9 * 2 / Sqr(3)
  73.     If wid < hgt Then
  74.         total_length = wid
  75.     Else
  76.         total_length = hgt
  77.     End If
  78.     start_x = picCanvas.ScaleWidth * 0.05
  79.     start_y = picCanvas.ScaleHeight * 0.95
  80.     ' Draw the curve.
  81.     picCanvas.CurrentX = start_x
  82.     picCanvas.CurrentY = start_y
  83.     SierpinskiGasketCurve depth, 0, total_length, -PI / 3
  84.     MousePointer = vbDefault
  85. End Sub
  86. ' Draw a gasket-like Sierpinski curve.
  87. Private Sub SierpinskiGasketCurve(ByVal depth As Integer, ByVal theta As Single, ByVal dist As Single, ByVal turn As Single)
  88.     If depth > 0 Then
  89.         SierpinskiGasketCurve depth - 1, theta + turn, dist / 2, -turn
  90.         SierpinskiGasketCurve depth - 1, theta, dist / 2, turn
  91.         SierpinskiGasketCurve depth - 1, theta - turn, dist / 2, -turn
  92.     Else
  93.         picCanvas.Line -Step(dist * Cos(theta), dist * Sin(theta))
  94.     End If
  95. End Sub
  96. ' Draw a hilbert curve.
  97. Private Sub Hilbert(ByVal depth As Integer, ByVal dx As Single, ByVal dy As Single)
  98.     If depth > 1 Then Hilbert depth - 1, dy, dx
  99.     picCanvas.Line -Step(dx, dy)
  100.     If depth > 1 Then Hilbert depth - 1, dx, dy
  101.     picCanvas.Line -Step(dy, dx)
  102.     If depth > 1 Then Hilbert depth - 1, dx, dy
  103.     picCanvas.Line -Step(-dx, -dy)
  104.     If depth > 1 Then Hilbert depth - 1, -dy, -dx
  105. End Sub
  106. Private Sub Form_Resize()
  107. Dim wid As Single
  108.     wid = ScaleWidth - picCanvas.Left
  109.     If wid < 120 Then wid = 120
  110.     picCanvas.Move picCanvas.Left, 0, _
  111.         wid, ScaleHeight
  112. End Sub
  113.